home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac 1993 September / September 93.iso / Archives / Applications / Text / Text Editors / Alpha 5.31 Folder / Tcl / UserCode / compare-windows.tcl < prev    next >
Encoding:
Text File  |  1993-01-23  |  4.8 KB  |  236 lines  |  [TEXT/ALFA]
  1. # FILE: compare-windows.tcl
  2. #
  3. # LAST UPDATE: 01/06/93 5:24:32 AM
  4. #
  5. # This file contains the following TCL procedure(s):
  6. #
  7. #    compare-windows -- Compare two windows from the cursor and position
  8. #                       the cursors at the next difference
  9. #
  10. # TCL SYNTAX:
  11. #
  12. #    NOTE: The options are not yet fully functional
  13. #
  14. #    compare-windows [-w|-b] [-c] [file1] [file2]
  15. #
  16. #    -b ignore blanks and tabs
  17. #    -w ignore blacks, tabs, newlines, returns
  18. #    -c case insenstive (ie. A matches a)
  19. #
  20. #    To use, simply source this file place it in the a folder with the
  21. #    name $HOME:Tcl:Usercode: and invoke it implicitly via the "unknown proc".
  22. #
  23. # SEE ALSO unknown.tcl
  24.  
  25. # COPYRIGHT:
  26. #
  27. #    Copyright © 1992,1993 by David C. Black
  28. #    All rights reserved.
  29. #
  30. #    Redistribution and use in source and binary forms are permitted
  31. #    provided that the above copyright notice and this paragraph are
  32. #    duplicated in all such forms and that any documentation,
  33. #    advertising materials, and other materials related to such
  34. #    distribution and use acknowledge that the software was developed
  35. #    by David C. Black.
  36. #
  37. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  38. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  39. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  40. #
  41. ################################################################################
  42.  
  43. # AUTHOR
  44. #
  45. #    David C. Black
  46. #    Internet: black@mpd.tandem.com (preferred)
  47. #    GEnie:    D.C.Black
  48. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  49. #
  50. ################################################################################
  51.  
  52. # HISTORY
  53. #                  
  54. # modified who rev reason
  55. # -------- --- --- ------
  56. # 01/06/93 DCB 1.0 Original
  57.  
  58. proc compare-windows {args} {
  59.  
  60.     set patt {}
  61.     set fold 0
  62.     set wins [winNames -f]
  63.     set files {}
  64.     if {[llength $args] > 0} {
  65.         foreach arg $args {
  66.             case $arg {
  67.                 {-c} {
  68.                     set fold 1
  69.                 }
  70.                 {-b} {
  71.                     set patt "\[ \t\]+"
  72.                 }
  73.                 {-w} {
  74.                     set patt "\[ \t\n\r\]+"
  75.                 }
  76.                 {} {
  77.                 }
  78.                 default {
  79.                     if {[string first ":" $arg] < 0} {
  80.                         set arg "[pwd]$arg"
  81.                     }
  82.                     set found 0
  83.                     foreach win $wins {
  84.                         if {$arg == $win} {
  85.                             set found 1
  86.                             break
  87.                         }
  88.                     }
  89.                     if {$found} {
  90.                         lappend files $arg
  91.                     } else {
  92.                         if {[file exists $arg]} {
  93.                             lappend files $arg
  94.                             edit $arg -r
  95.                         } else {
  96.                             alertnote "Cannot read $arg"
  97.                         }
  98.                     }
  99.                 }
  100.             }
  101.         }
  102.     }
  103.     set files [concat $files $wins]
  104.  
  105.     if {[llength $files] < 2} {
  106.         alertnote "Need at least 2 windows/files"
  107.         return
  108.     }
  109.  
  110.     # Get window 1 text to compare
  111.     set wn(1) [lindex $files 0]
  112.     bringToFront $wn(1)
  113.     if {[getSelect] != ""} {
  114.         forwardChar
  115.     }
  116.     set wp(1) [getPos]
  117.     set wo(1) [getText $wp(1) [maxPos]]
  118.     set wt(1) $wo(1)
  119.     if {$patt != ""} {
  120.         regsub -all $patt $wt(1) " " wt(1)
  121.     }
  122.     if {$fold} {
  123.         set wt(1) [string tolower $wt(1)]
  124.     }
  125.  
  126.     # Get window 2 text to compare
  127.     set wn(2) [lindex $files 1]
  128.     bringToFront $wn(2)
  129.     if {[getSelect] != ""} {
  130.         forwardChar
  131.     }
  132.     set wp(2) [getPos]
  133.     set wo(2) [getText $wp(2) [maxPos]]
  134.     set wt(2) $wo(2)
  135.     if {$patt != ""} {
  136.         regsub -all $patt $wt(2) " " wt(2)
  137.     }
  138.  
  139.     # Exactly equal
  140.     if {$wt(1) == $wt(2)} {
  141.         message "Identical"
  142.         return
  143.     }
  144.  
  145.     # Only consider smaller of two strings    
  146.     set siz [string length $wt(1)]
  147.     if {$siz > [string length $wt(2)]} {
  148.         set siz [string length $wt(2)]
  149.     }
  150.     
  151.     # Equal except for added stuff
  152.     set l [expr {$siz-1}]
  153.     if {[string range $wt(1) 0 $l] == [string range $wt(2) 0 $l]} {
  154.         set beg $siz
  155.         set offset(1) $beg
  156.         set offset(2) $beg
  157.     } else {
  158.         set beg 0
  159.         set trace {}
  160.     
  161.         while {$siz} {
  162.             set siz [expr {$siz / 2}]
  163.             set end [expr {$beg+$siz}]
  164.             if {[string range $wt(1) $beg $end] == [string range $wt(2) $beg $end]} {
  165.                 incr beg $siz
  166.                 incr beg
  167.             }
  168.         }
  169.  
  170.         set offset(1) $beg
  171.         set offset(2) $beg
  172.     
  173.         # adjust for $patt
  174.         if {$patt != ""} {
  175.             foreach i {1 2} {
  176.                 set front ""
  177.                 set left [expr {$beg+1}]
  178.                 set back $wo($i)
  179.                 set iterations 0
  180.                 while {$left > 0} {
  181.                     append front [string range $back 0 [expr {$left-1}]]
  182.                     set    back  [string range $back $left end]
  183.                     regsub -all $patt $front { } front
  184.                     set left [expr {$beg + 1 - [string length $front]}]
  185.                     incr offset($i) $left
  186.                     if {[incr iterations] > 100} {
  187.                         alertnote "diff: iterations exceeded 100"
  188.                         break
  189.                     }
  190.         #BEG DEBUG
  191.         global testing
  192.         if {$testing} {
  193.             set o $offset($i)
  194.             regsub -all "\[\r\n\]*" $front "•" t
  195.             if {[getline "$i«$t» $left/$o" "continue"] != "continue"} {
  196.                 break
  197.             }
  198.         }
  199.         #END DEBUG
  200.                 }
  201.             }
  202.             
  203.         }
  204.     }
  205.     
  206.  
  207. #    bringToFront $wn(2)
  208.     set pos [expr {$wp(2)+$offset(2)}]
  209.     if {$pos > [maxPos]} {
  210.         goto end
  211.     } else {
  212.         goto $pos
  213.     }
  214.     centerRedraw
  215.     forwardCharSelect
  216.  
  217.     bringToFront $wn(1)
  218. #    listpick $trace
  219.     set pos [expr {$wp(1)+$offset(1)}]
  220.     if {$pos > [maxPos]} {
  221.         goto end
  222.     } else {
  223.         goto $pos
  224.     }
  225.     centerRedraw
  226.     forwardCharSelect
  227.  
  228.     return
  229. }
  230.  
  231. set testing 0
  232. if {$testing} {
  233.     set cwd [pwd]
  234.     diff -b "${cwd}TCLs:1.txt" "${cwd}TCLs:2.txt"
  235. }
  236.